Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/OOStaticEdit.p

Text File | 1994-08-27 | 13.4 KB | 504 lines | [TEXT/PJMM]

unit OOStaticEdit;

interface

    type
        TEStaticObject = object
                window: dialogPtr;
                titem: integer;
                vcontrol, hcontrol: controlHandle;
                te: TEHandle;
                titemr: rect;
                hasgrow, drawgrow: boolean; { hasgrow -> leave room for grow icon, drawgrow -> draw it during updates }
                doubleClickTime, tripleClickTime: longInt;
                procedure Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrowb, drawgrowb: boolean);
                procedure Destroy;
                procedure Adjust;
                procedure Resize;
                procedure Draw;
                function EditMenuEnabled: boolean;
                procedure SetEditMenuItem (item: integer);
                procedure DoEditMenu (item: integer);
                procedure DoItemWhere (er: eventRecord; item: integer);
                procedure DoIdle;
                procedure DoKey (modifiers: integer; ch: char);
                procedure DoActivateDeactivate (activate: boolean);
                procedure ClickLoop;
                procedure Click (pt: point; extend: boolean);
                function WordBreak (text: ptr; pos: integer; forward: boolean): boolean;
            end;

implementation

    uses
        MyOOMainLoop, BaseGlobals, MyTypes, MyUtils, MySystemGlobals, MyMenus;

    var
        teo: TEStaticObject;
        teOriginalClickLoop: procPtr;

{ DON'T EVEN THINK ABOUT LOOKING AT THIS CODE!!!!! }

    procedure CallCL (addr: procPtr);
    inline
        $205F, $4E90;

    procedure SetD0to1;
    inline
        $7001;

    function GetD2: longInt;
    inline
        $2F42, $0000;

    procedure Unlink;
    inline
        $4E5E;

    procedure Link;
    inline
        $4E56, $0000;

{$PUSH}
{$D-}
  { Turn debug off, lest our qute little SetD0to1 hack gets crunged by TP }
    procedure CallClickLoop;  { There must be a better way to sort out this crap! }
    begin
        Unlink;  { This is a rediculous hack! }
        CallCL(teOriginalClickLoop);
        Link;
        teo.ClickLoop;
        SetD0to1;
    end;

    function CallWordBreak (text: ptr; pos: integer): boolean;
        var
            d2: longInt;
    begin
        d2 := GetD2;
        CallWordBreak := teo.WordBreak(text, pos, BAND(d2, $00020000) = 0);
    end;
{$POP}

    function FindEOL (te: TEHandle; loc: integer): integer;
    begin
        while (loc < te^^.teLength) and (ptr(longInt(te^^.hText^) + loc)^ <> 13) do
            loc := loc + 1;
        FindEOL := loc;
    end;

    procedure TEStaticObject.Click (pt: point; extend: boolean);
        var
            tc, dct: longInt;
            doubleclick, tripleclick: boolean;
            teOriginalWordBreak: procPtr;
            eol: integer;
    begin
        SetPort(window);
        tc := TickCount;
        doubleclick := tc < doubleClickTime;
        tripleclick := tc < tripleClickTime;
        teo := self;
        teOriginalClickLoop := te^^.clikLoop;
        te^^.clikLoop := @CallClickLoop;
        teOriginalWordBreak := te^^.wordBreak;
        if tripleclick then
            SetWordBreak(@CallWordBreak, te);
        if extend and tripleclick then begin{ we must fake text edit into not shrinking the selection somehow }
            eol := FindEOL(te, te^^.selStart);  { if start<=clickloc<=EOL(start)<selEnd }
            if (te^^.selStart <= te^^.clickloc) and (te^^.clickloc <= eol) and (eol < te^^.selEnd) then
                TESetSelect(te^^.clickloc, te^^.selEnd, te);
        end;
        TEClick(pt, extend, te);
        tc := TickCount;
        dct := GetDblTime;
        doubleClickTime := tc + dct;
        if doubleclick then
            tripleClickTime := tc + dct;
        te^^.clikLoop := teOriginalClickLoop;
        te^^.wordBreak := teOriginalWordBreak;
    end;

    procedure TEStaticObject.Create (dlg: dialogPtr; item, width: integer; vscroll, hscroll, hasgrowb, drawgrowb: boolean);
        var
            dr, vr: rect;
            k: integer;
            h: handle;
    begin
        doubleClickTime := -1;
        tripleClickTime := -1;
        SetPort(dlg);
        window := dlg;
        titem := item;
        hasgrow := hasgrowb;
        drawgrow := drawgrowb;
        if vscroll then begin
            SetRect(dr, 0, 0, 16, 100);
            vcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 0);
        end
        else
            vcontrol := nil;
        if hscroll then begin
            SetRect(dr, 0, 0, 100, 16);
            hcontrol := NewControl(window, dr, '', true, 0, 0, 0, scrollBarProc, 0);
        end
        else
            hcontrol := nil;
        GetDItem(dlg, titem, k, h, dr);
        titemr := dr;
        EraseRect(dr);
        vr := dr;
        dr.right := dr.left + width;
        te := TENew(dr, vr);
        TEAutoView(true, te);
        Resize;
    end;

    procedure TEStaticObject.Destroy;
    begin
        TEDispose(te);
        dispose(self);
    end;

    procedure AdjustTE (te: TEHandle; hc, vc: integer);
{Scroll the TERec around to match up to the potentially updated scrollbar}
{values. This is really useful when the window resizes such that the}
{scrollbars become inactive and the TERec had been previously scrolled.}
        var
            value: INTEGER;
    begin
        with te^^ do
            TEScroll((viewRect.left - destRect.left) - hc, (viewRect.top - destRect.top) - (vc * lineHeight), te);
    end; {AdjustTE}

    function AdjustHV (isVert: BOOLEAN; control: ControlHandle; te: TEHandle; canRedraw: BOOLEAN): integer;
{Calculate the new control maximum value and current value, whether it is the horizontal or}
{vertical scrollbar. The vertical max is calculated by comparing the number of lines to the}
{vertical size of the viewRect. The horizontal max is calculated by comparing the maximum document}
{width to the width of the viewRect. The current values are set by comparing the offset between}
{the view and destination rects. If necessary and we canRedraw, have the control be re-drawn by}
{calling ShowControl.}
        var
            value, lines, max: INTEGER;
            oldValue, oldMax: INTEGER;
            cliprgn: RgnHandle;
            r: rect;
    begin
        oldValue := GetCtlValue(control);
        oldMax := GetCtlMax(control);
        with te^^ do begin
            if isVert then begin
                lines := nLines;
        {since nLines isn’t right if the last character is a return, check for that case}
                if (teLength > 0) & (Ptr(ORD(hText^) + teLength - 1)^ = 13) then
                    lines := lines + 1;
                max := lines - ((viewRect.bottom - viewRect.top) div lineHeight);
            end
            else
                max := destRect.right - destRect.left - (viewRect.right - viewRect.left);
            if max < 0 then
                max := 0;            {check for negative values}
            if isVert then
                value := (viewRect.top - destRect.top) div lineHeight
            else
                value := viewRect.left - destRect.left;
            if value < 0 then
                value := 0
            else if value > max then
                value := max;                    {pin the value to within range}
        end;
        SetPort(te^^.inPort);
        clipRgn := NewRgn;
        GetClip(clipRgn);
        SetRect(r, 0, 0, 0, 0);
        ClipRect(r);
        SetCtlMax(control, max);
        SetClip(clipRgn);
        DisposeRgn(clipRgn);
        SetCtlValue(control, value);
        if canRedraw and ((max <> oldMax) or (value <> oldValue)) then
            ShowControl(control);            {check to see if the control can be re-drawn}
        AdjustHV := value;
    end; {AdjustHV}

    procedure TEStaticObject.Adjust;
        var
            hc, vc: integer;
    begin
        vc := AdjustHV(true, vcontrol, te, false);
        hc := AdjustHV(false, hcontrol, te, false);
        AdjustTE(te, hc, vc);
    end; {AdjustScrollValues}

    procedure TEStaticObject.Resize;
        const
            invis = 0;
            vis = 255;
            inset = 3;
        var
            dr, vr, r, tr: rect;
            pt: point;
            k: integer;
            h: handle;
            wd, ht: integer;
            hc, vc: integer;
    begin
        SetPort(window);
        EraseRect(titemr);
        GetDItem(window, titem, k, h, tr);
        titemr := tr;
        InvalRect(tr);
        vr := tr;
        InsetRect(vr, inset, inset);
        if hcontrol <> nil then
            vr.bottom := vr.bottom - 15;
        if vcontrol <> nil then
            vr.right := vr.right - 15;
        vr.bottom := vr.top + (vr.bottom - vr.top) div te^^.lineHeight * te^^.lineHeight;

        pt := vr.topleft;
        SubPt(te^^.viewRect.topleft, pt);
        OffsetRect(te^^.destRect, pt.h, pt.v);

        te^^.viewRect := vr;

        if vcontrol <> nil then begin
            vcontrol^^.contrlVis := invis;
            MoveControl(vcontrol, tr.right - 16, tr.top);
            ht := tr.bottom - tr.top;
            if hasgrow then
                ht := ht - 15;
            SizeControl(vcontrol, 16, ht);
            vc := AdjustHV(true, vcontrol, te, false);
            vcontrol^^.contrlVis := vis;
        end;
        if hcontrol <> nil then begin
            hcontrol^^.contrlVis := invis;
            MoveControl(hcontrol, tr.left, tr.bottom - 16);
            ht := tr.right - tr.left;
            if hasgrow or (vcontrol <> nil) then
                ht := ht - 15;
            SizeControl(hcontrol, ht, 16);
            hc := AdjustHV(false, hcontrol, te, false);
            hcontrol^^.contrlVis := vis;
        end;
        AdjustTE(te, hc, vc);
    end;

    procedure TEStaticObject.Draw;
        var
            r: rect;
            pt: point;
            k: integer;
            h: handle;
    begin
        GetDItem(window, titem, k, h, r);
        EraseRect(r);
        if drawgrow then begin
            DrawGrowIcon(window);
        end;
        if vcontrol <> nil then begin
            Draw1Control(vcontrol);
        end;
        if hcontrol <> nil then begin
            Draw1Control(hcontrol);
        end;
        EraseRect(te^^.viewRect);
        TEUpdate(te^^.viewRect, te);
    end;

    procedure TEStaticObject.DoActivateDeactivate (activate: boolean);
    begin
        if drawgrow then
            DrawGrowIcon(window);
        if activate then
            TEActivate(te)
        else
            TEDeactivate(te);
    end;

{ Common algorithm for pinning the value of a control. It returns the actual amount }
{ the value of the control changed. }
    procedure CommonAction (control: ControlHandle; var amount: integer);
        var
            value, max: integer;
    begin
        value := GetCtlValue(control);
        max := GetCtlMax(control);
        amount := value - amount;
        if (amount <= 0) then
            amount := 0
        else if (amount >= max) then
            amount := max;
        SetCtlValue(control, amount);
        amount := value - amount;   { calculate true change }
    end; { CommonAction  }

    var
        actionTE: TEHandle;

{ Determines how much to change the value of the vertical scrollbar by and how }
{ much to scroll the TE record.}
    procedure VActionProc (control: ControlHandle; part: integer);
        var
            amount: integer;
            window: WindowPtr;
    begin
        if (part <> 0) then begin
            window := control^^.contrlOwner;
            case part of
                inUpButton, inDownButton:        { one line  }
                    amount := 1;
                inPageUp, inPageDown:            { one page  }
                    with actionTE^^, viewRect do
                        amount := (bottom - top) div lineHeight;
            end;
            if ((part = inDownButton) or (part = inPageDown)) then
                amount := -amount;        { reverse direction for a downer  }
            CommonAction(control, amount);
            if (amount <> 0) then
                TEScroll(0, amount * actionTE^^.lineHeight, actionTE);
        end;
    end; { VActionProc }

{ Determines how much to change the value of the horizontal scrollbar by and how }
{ much to scroll the TE record. }
    procedure HActionProc (control: ControlHandle; part: integer);
        var
            amount: integer;
            window: WindowPtr;
    begin
        if (part <> 0) then begin
            window := control^^.contrlOwner;
            case part of
                inUpButton, inDownButton:        { a few pixels }
                    amount := 8;
                inPageUp, inPageDown:            { a page width }
                    with actionTE^^.viewRect do
                        amount := (right - left);
            end;
            if ((part = inDownButton) or (part = inPageDown)) then
                amount := -amount;        { reverse direction }
            CommonAction(control, amount);
            if (amount <> 0) then
                TEScroll(amount, 0, actionTE);
        end;
    end; { HActionProc }

{ Gets called from CallClickLoop which in turn }
{ is called by the TEClick toolbox routine. Saves the window's clip region, }
{ sets it to the portRect, adjusts the scrollbar values to match the TE scroll }
{ amount, then restores the clip region. }
    procedure TEStaticObject.ClickLoop;
        var
            region: RgnHandle;
            vc, hc: integer;
    begin
        SetPort(window);
        region := NewRgn;
        GetClip(region);                { save the old clip }
        ClipRect(window^.portRect);        { set the new clip }
        vc := AdjustHV(true, vcontrol, te, false);
        hc := AdjustHV(false, hcontrol, te, false);
        SetClip(region);                { restore the old clip }
        DisposeRgn(region);
    end; { PascalClikLoop }

    function TEStaticObject.WordBreak (text: ptr; pos: integer; forward: boolean): boolean;
    begin
        if forward then
            WordBreak := (pos > 0) and (ptr(longInt(text) + pos - 1)^ = 13)
        else
            WordBreak := ptr(longInt(text) + pos)^ = 13
    end;

    procedure TEStaticObject.DoItemWhere (er: eventRecord; item: integer);
        var
            control: controlHandle;
            value, part: integer;
    begin
        SetPort(window);
        GlobalToLocal(er.where);
        part := FindControl(er.where, window, control);
        if part = 0 then begin
            if PtInRect(er.where, te^^.viewRect) then
                Click(er.where, BAND(er.modifiers, shiftKey) <> 0)
        end
        else begin
            if part = inThumb then begin
                value := GetCtlValue(control);
                part := TrackControl(control, er.where, nil);
                if part <> 0 then begin
                    value := value - GetCtlValue(control);
                    if value <> 0 then
                        if control = vcontrol then
                            TEScroll(0, value * te^^.lineHeight, te)
                        else
                            TEScroll(value, 0, te);
                end;
            end
            else begin
                actionTE := te;
                if control = vcontrol then
                    value := TrackControl(control, er.where, @VActionProc)
                else
                    value := TrackControl(control, er.where, @HActionProc);
            end;
        end;
    end;

    function TEStaticObject.EditMenuEnabled: boolean;
        var
            i: integer;
    begin
        for i := EMundo to EMselectall do
            if i <> EMundo + 1 then
                SetEditMenuItem(i);
        EditMenuEnabled := (te^^.selStart < te^^.selEnd) or (te^^.teLength > 0);
    end;

    procedure TEStaticObject.SetEditMenuItem (item: integer);
    begin
        case item of
            EMundo, EMcut, EMpaste, EMclear:  { Can't undo, cut, copy, paste in a static edit thingy }
                SetIDItemEnable(M_Edit, item, false);
            EMcopy:
                SetIDItemEnable(M_Edit, item, te^^.selStart < te^^.selEnd);  { Can copy iff there is a selection }
            EMselectall:
                SetIDItemEnable(M_Edit, item, te^^.teLength > 0);  { Can select all iff there is something to select }
            otherwise
        end;
    end;

    procedure TEStaticObject.DoEditMenu (item: integer);
        var
            oe: OSErr;
            loe: longInt;
    begin
        case item of
            EMcopy:  begin
                TECopy(te);
                loe := ZeroScrap;
                oe := TEToScrap;
            end;
            EMselectall:  begin
                SetPort(window);
                TESetSelect(0, maxLongInt, te);
            end;
            otherwise
        end;
    end;

    procedure TEStaticObject.DoIdle;
    begin
        TEIdle(te);
    end;

    procedure TEStaticObject.DoKey (modifiers: integer; ch: char);
    begin
        if BAND(modifiers, cmdKey) = 0 then
            TEKey(ch, te);
        Adjust;
    end;

end.